セルからデータを抽出し、セルをアルファベット順に並べ替えるにはどうすればよいですか? (How do I extract data from a cell and order the cells alphabetically?)

問題の説明

セルからデータを抽出し、セルをアルファベット順に並べ替えるにはどうすればよいですか? (How do I extract data from a cell and order the cells alphabetically?)

Excel の変更を自動化しようとしています。

プロセスは次のように機能します:

1. Excel リストが作成されます。
2. 必要です従業員が手動で処理します (画像の削除、アルファベット順など)。
3. リストは csv ファイルに変換されます。
4. CSV はアップロードされて処理されます。

このプロセスを可能な限り自動化したいと考えています。私は VBA や Excel マクロを使った経験がありません。

これまでのところ、いくつかの異なるスクリプトを混ぜ合わせて途中まで進めることができましたが、これら 2 つを得ることができませんでした。機能が働いています。上部 (まだ下部ではない) の膨張をすべて削除し、空の行を削除し、未使用の列を削除することができました。

プライバシー上の理由から、シート自体の内容を投稿することはできませんが、シートの構造は次のようになります:

| Name | Cost |

| Mark Renner (mare) | €200,‑ |

質問

4 文字のコードを抽出してフル ネームに置き換えたいので、4 文字のコードだけがセルに残ります。

また、リストをアルファベット順に並べ替えたいと思います。シートの範囲は日ごとに異なるため、固定量のセルはありません。

このシートには他に心配する必要はありません。必要に応じて、さらに情報を提供できます。

誰かがこれを手伝ってくれたら、とても助かります。

よろしくお願いします!

編集:

さらに要求された情報を次に示します。

現在のスクリプト後のテーブルの例

これは、すべての肥大化を取り除くために現在使用しているスクリプトです。完璧ではないと思いますが、今のところうまくいきます。

    Sub run()
    Call testvba
    Call DeleteRowWithContents
    Call usedR
    End Sub

    Sub testvba()
    Dim i As Integer
    For i = 1 To 21
    Rows(1).EntireRow.Delete
    Next i

    For i = 1 To 10
    Columns(4).EntireColumn.Delete
    Next i

    Dim shape As Excel.shape
    For Each shape In ActiveSheet.Shapes
    shape.Delete
    Next


    End Sub

    Sub DeleteRowWithContents()
    Last = Cells(Rows.Count, "A").End(xlUp).Row
    For i = Last To 1 Step ‑1
        If (Cells(i, "A").Value) = "User" Then
            Cells(i, "A").EntireRow.Delete
        End If
    Next i
    End Sub

    Sub usedR()
    ActiveSheet.UsedRange.Select
    'Deletes the entire row within the selection if the ENTIRE row contains no      data.
    Dim i As Long
    'Turn off calculation and screenupdating to speed up the macro.
    With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    'Work backwards because we are deleting rows.
    For i = Selection.Rows.Count To 1 Step ‑1
    If WorksheetFunction.CountA(Selection.Rows(i)) = 0 Then
    Selection.Rows(i).EntireRow.Delete
    End If
    Next i
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    End With
    End Sub `

スクリプトの前の表:

以前

解決策:

4 文字のコードです。

最終的にこのコード行を使用して、レコードをアルファベット順に並べ替えました:

    Sub Alpha()
    Dim fromRow As Integer
    Dim toRow As Integer
    fromRow = 1
    toRow = ActiveSheet.UsedRange.Rows.Count
        ActiveSheet.Rows(fromRow & ":" & toRow).Sort Key1:=ActiveSheet.Range("A:A"), _
           Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, _
           MatchCase:=False, Orientation:=xlTopToBottom
    End Sub

リファレンスソリューション

方法 1:

To get the 4 letter code you can search for the "(" and cut the string down

Something like this will get you to the code, you could use regedit but that seems like overkill

Sub ReplaceName()
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For r = 2 to LastRow 'assumes data starts in row 2 with header in row 1
    if Cells(r,1).value = "" then goto Nextr 'skips blanks
    CurrentString = Cells(r,1).value 'assumes the names are in column 1
    'At this point CurrentString = "Mark Renner (mare)"
    CurrentString = Right(CurrentString,len(CurrentString)‑instr(1,CurrentString,"("))
    'At this point CurrentString = "mare)"
    CurrentString = left(CurrentString,instr(1,CurrentString,")")‑1)
    'At this point CurrentString = "mare"
    Cells(r,1).value = CurrentString
Nextr:
Next r
End Sub

As far as putting it in alphabetical order, there are two ways that come to mind

1. Move all of the values into an array then iterate through the array and sort them
2. Create a filtered range and filter is

the second option is MUCH easier, and for what you're doing I think it's probably fine. It'll look something like this:

With data that looks like this (in cells A1 to B6):

Name    Cost
Tom     149
Dick    272
Harry   186
Moe     292
Larry   377

I'd do something like this:

Sub SortAlpha()
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

Range(Cells(1,1),Cells(LastRow,2)).select 'selects the data and headers
Selection.AutoFilter 'Adds Filter
ActiveWorkbook.ActiveSheet.AutoFilter.Sort.SortFields.Clear

Range(Cells(1, 1), Cells(LastRow, 1)).Select 'selects name column

'filters alpha
ActiveWorkbook.ActiveSheet.AutoFilter.Sort.SortFields.Add Key:=Selection _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.ActiveSheet.AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

Range(Cells(1,1),Cells(LastRow,2)).select 'selects the data and headers
Selection.AutoFilter 'Removes Filter
End Sub

That'll Give you this:

Name    Cost
Dick    272
Harry   186
Lary    377
Moe     292
Tom     149

As Far as cleaning the data I usually do a couple of things when I have data tables that are really messy

Start Here:

 1. iterate through the range and remove all merges
 2. unwrap all of the text
 3. delete all pictures
 4. Delete any blank Rows or columns

I like this code for finding the last row:

LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

You can modify it to find the last column

LastCol = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

Then you can loop through your whole sheet cell by cell, or as a range Cell by Cell: (I use this to unmerge the cells ‑ can be slow)

For r = 1 to LastRow
    For c = 1 to LastCol
       'Do Stuff
       Cells(r,c).UnMerge 'or Cells(r,c).MergeCells = False
    Next c
Next r

or as a range: I use this for unwrapping the text

Range(Cells(1,1),Cells(LastRow,LastCol)).WrapText = False

To delete the pictures I use this code: Deleting pictures with Excel VBA

Dim shape As Excel.shape
For Each shape In ActiveSheet.Shapes
    shape.Delete
Next

This seems like it would work for saving the csv if you wanted to automate that also:

Saving excel worksheet to CSV files with filename+worksheet name using VB

I'd re‑resize all of your rows and columns, rows to their default and columns to the fit: Unfortunately I haven't found a great way to do the rows without a range string so my code is a little messy:

RowRange = "1:" & LastRow
Rows(RowRange).RowHeight = 12.75

Columns are about the same, but worse because they're not numbered

ColStart = Cells(1,1).Address
ColEnd = Cells(1,LastCol).Address
ColStart = left(ColStart,len(ColStart)‑1)
ColEnd = left(ColEnd,len(ColEnd)‑1)
ColStart = Replace(ColStart,"$","")
ColEnd = Replace(ColEnd,"$","")
ColRange = ColStart & ":" & ColEnd
Columns(ColRange).EntireColumn.AutoFit

you could alternatively just make it significantly large, but where's the fun in that?

Columns("A:ZZ").EntireColumn.AutoFit

(by Alterlai、Schalton)

リファレンスドキュメント

1. How do I extract data from a cell and order the cells alphabetically? (CC BY‑SA 2.5/3.0/4.0)